﻿/// /////////////////////////////////////////////
// 单元名 : unitMsgObj
// 作者 : Hawk
// 单元描述 : 本单元定义系统中信息传递对象
// 日期 : 2023-09-15
/// /////////////////////////////////////////////

{$IFDEF FPC}
{$H+}
{$MODE DELPHI}
{$ENDIF}
unit unitMsgObj;

interface

uses {$IFDEF MSWINDOWS}{$ENDIF}
{$IFnDEF FPC}
  Windows,
{$ELSE}
{$ENDIF}
  unitDDLinkList, unitCommonDataStruct, unitIOCPDataObj, unitObjPool;

type
  TMsg = class(TSerialObj)
  private
    FSourceObjID: TID_OBJ;
    FTargetObjID: TID_OBJ;
    FMsgID: Longword;
    FCommID: Longword;
    FError: ERRCODE;
    FData: Longword;
    FCurObj: TDoubleDirLinkListItem;
    FConnObj: Pointer;
    FDelayTick: Longword;
  protected
    procedure DoAssign(Source: TSerialObj); override;
    procedure DoClone(Target: TSerialObj); override;
    procedure DoReadFromPack(PropertyIdx, Len: Longword; Buf: TIOCPDataCollecter); override;
    procedure DoWritePropertyToPack(dp: TIOCPDataCollecter); override;
    procedure DoDumpObj; override;
  public
    class function ClassID: Longword; override;
    procedure Reset; override;

    function AddIDObj(const id: TID_OBJ; str: string = ''; data: Pointer = nil; force: Boolean = False): TStringObj;

    property SourceObjID: TID_OBJ read FSourceObjID write FSourceObjID;
    property TargetObjID: TID_OBJ read FTargetObjID write FTargetObjID;
    property CurExecObj: TDoubleDirLinkListItem read FCurObj write FCurObj;
    property MsgID: Longword read FMsgID write FMsgID;
    property Error: ERRCODE read FError write FError;
    property data: Longword read FData write FData;
    property ConnObj: Pointer read FConnObj write FConnObj;
    property CommID: Longword read FCommID write FCommID;
    property DelayTick: Longword read FDelayTick write FDelayTick;
  end;

implementation

uses unitMisc, unitClassIDDef;

{ TMsgObj }

function TMsg.AddIDObj(const id: TID_OBJ; str: string; data: Pointer; force: Boolean): TStringObj;
begin
  Result := TStringObj(FindItemLowerLevel(id));
  if force or (Result = nil) then
  begin
    Result := ObjPool.GetObj(TStringObj, Self);
    Result.ObjID := id;
    Result.str := str;
    Result.data := data;
    AppendItem(Result);
  end;
end;

class function TMsg.ClassID: Longword;
begin
  Result := CLASSID_MSG;
end;

procedure TMsg.DoAssign(Source: TSerialObj);
var
  src: TMsg ABSOLUTE Source;
begin
  inherited;
  FSourceObjID := src.FSourceObjID;
  FTargetObjID := src.FTargetObjID;
  FMsgID := src.FMsgID;
  FCommID := src.FCommID;
  FError := src.FError;
  FData := src.FData;
  FCurObj := src.FConnObj;
  FConnObj := src.FConnObj;
  FDelayTick := src.FDelayTick;
end;

procedure TMsg.DoClone(Target: TSerialObj);
var
  tmp: TMsg absolute Target;
begin
  inherited;
  tmp.FSourceObjID := FSourceObjID;
  tmp.FTargetObjID := FTargetObjID;
  tmp.FMsgID := FMsgID;
  tmp.FCommID := FCommID;
  tmp.FData := FData;
  tmp.FError := FError;
  tmp.FCurObj := FCurObj;
end;

procedure TMsg.DoDumpObj;
begin
  inherited;
  DumpStr('  MsgID %x', [MsgID]);
  DumpStr('  Source %s Target %s ', [FSourceObjID.ToString, FTargetObjID.ToString]);
end;

procedure TMsg.DoReadFromPack(PropertyIdx, Len: Longword; Buf: TIOCPDataCollecter);
begin
  case PropertyIdx of
    1:
      Buf.ReadBuf(FSourceObjID, Len);
  else
    Inherited;
  end;
end;

procedure TMsg.DoWritePropertyToPack(dp: TIOCPDataCollecter);
begin
  WritePropertyToPack(dp, 1, SizeOf(FSourceObjID) + SizeOf(FTargetObjID) + SizeOf(FMsgID) + SizeOf(FError) +
    SizeOf(FData) + SizeOf(FCommID), FSourceObjID);
  Inherited;
end;

procedure TMsg.Reset;
begin
  inherited;
  FSourceObjID.Empty;
  FTargetObjID.Empty;
  FMsgID := 0;
  FData := 0;
  FCurObj := nil;
  FConnObj := nil;
  FCommID := 0;
  FDelayTick := 0;
  FError := 0;
end;

initialization

ObjPool.RegisterObjClass(TMsg);

end.
